home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Demos / mc-server.stk < prev    next >
Encoding:
Text File  |  1996-07-23  |  2.7 KB  |  89 lines
  1. #!/usr/local/bin/stk -load
  2. ;;;;
  3. ;;;; m c - s e r v e r  . s t k        -- A simple server which accept
  4. ;;;;                       multiple client connections
  5. ;;;;
  6. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  7. ;;;; 
  8. ;;;; Permission to use, copy, and/or distribute this software and its
  9. ;;;; documentation for any purpose and without fee is hereby granted, provided
  10. ;;;; that both the above copyright notice and this permission notice appear in
  11. ;;;; all copies and derived works.  Fees for distribution or use of this
  12. ;;;; software or derived works may only be charged with express written
  13. ;;;; permission of the copyright holder.  
  14. ;;;; This software is provided ``as is'' without express or implied warranty.
  15. ;;;;
  16. ;;;; This software is a derivative work of other copyrighted softwares; the
  17. ;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
  18. ;;;;
  19. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  20. ;;;;    Creation date: 23-Jul-1996 09:00
  21. ;;;; Last file update: 23-Jul-1996 10:09
  22.  
  23. (require "posix")
  24. (require "socket")
  25.  
  26. (define register-connection
  27.   (let ((sockets '()))
  28.  
  29.     (lambda (s cnt)
  30.       ;; Accept connection
  31.       (socket-accept-connection s)
  32.  
  33.       ;; Save socket somewher to avoid GC problems
  34.       (set! sockets (cons s sockets))
  35.   
  36.       (let ((in   (socket-input s))
  37.         (out  (socket-output s))
  38.         (who  (socket-host-name s))
  39.         (addr (socket-host-address s)))
  40.          
  41.     ;; Display a greeting message
  42.     (format out "Welcome ~A on server ~A\n" who (posix-host-name))
  43.     (flush out)
  44.  
  45.     ;; Signal new connection on standard output
  46.     (format #t  "New connection detected from ~A (~A)\n" who addr)
  47.  
  48.     ;; Create a handler for reading inputs from this new connection
  49.     (when-port-readable in 
  50.         (lambda ()
  51.           ;; And read all the lines comming from distant machine
  52.           (let ((l (read-line in)))
  53.             (if (eof-object? l)
  54.             ;; delete current handler
  55.             (begin
  56.               (when-port-readable in #f)
  57.               (socket-shutdown s))
  58.             ;; Just write the line read on the socket
  59.             (begin
  60.               (format out "On connection #~S I've read --> ~A\n" cnt l)
  61.               (flush out))))))))))
  62.  
  63. ;;;;
  64. ;;;; Program starts here
  65. ;;;;
  66. (system "clear")
  67.  
  68. (define s (make-server-socket))
  69.  
  70. (format #t "Welcome on the multi-server demo
  71. To use it you can open several windows and you can create a new connection with
  72.     telnet ~A ~A
  73. To exit this demo, just type
  74.     (exit)
  75. at the STk prompt
  76. ---------------------------------\n\n"
  77. (posix-host-name) (socket-port-number s))
  78.  
  79. (when-socket-ready s (let ((count 0))
  80.                (lambda ()
  81.              (set! count (+ count 1))
  82.              (register-connection (socket-dup s) count))))
  83.  
  84.  
  85. (format #t "Server ~A (~A) is waiting connection on port ~A ...\n"
  86.     (posix-host-name) (socket-local-address s) (socket-port-number s))
  87. (flush (current-output-port))
  88.  
  89.